home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DATETIME.SWG / 0046_RTC direct access....pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  4KB  |  97 lines
  1. {
  2. MD>What would anyone here recommend as being the best way for DOS
  3.   >protected mode to get the current time of day *without* flipping
  4.   >back to real mode to make a standard DOS call?
  5.  
  6.  If your code is allowed to talk to the real-time clock (RTC) chip,
  7.  here's some example code to access the RTC directly. The functions
  8.  work solely with 24-hr time format (if needed, internally by the RTC,
  9.  they translate between 12/24-hr times and binary/BCD formats)...
  10. }
  11.  
  12. (*******************************************************************)
  13. PROGRAM RClock;         { Get/Set Time/Date directly from RTC chip  }
  14.                         { June 9, 1994. Greg Vigneault              }
  15. TYPE  Treg = 0..$D;     { range for time/date register addresses    }
  16.       To23 = 0..23;     { range for hours                           }
  17.       To59 = 0..59;     { range for minutes and seconds             }
  18. VAR   Yr, Mth, Day, DoW, Hr, Min, Sec : BYTE;
  19.  
  20. FUNCTION RTCbusy:BOOLEAN; BEGIN { RTC time/date being updated?... }
  21.     Port[$70] := $A;;  RTCbusy := (Port[$71] AND 128) = 128;
  22.   END {RTCbusy};
  23.  
  24. FUNCTION ReadReg (Reg:Treg):BYTE; BEGIN { read an RTC register... }
  25.     IF Reg IN [0..9] THEN REPEAT {wait} UNTIL NOT RTCbusy;
  26.     Port[$70] := Reg;;  ReadReg := Port[$71];
  27.   END {ReadReg};
  28.  
  29. PROCEDURE WriteReg (Reg:Treg; Data:BYTE); { write RTC reg... }
  30.   VAR temp:BYTE; BEGIN
  31.     IF Reg IN [0..9] THEN BEGIN { time/date reg? }
  32.       REPEAT {wait} UNTIL NOT RTCbusy;
  33.       Port[$70] := $B;; temp := Port[$71];; Port[$71] := temp OR $80;
  34.     END{IF};
  35.     Port[$70] := Reg;;  Port[$71] := Data;
  36.     IF Reg IN [0..9] THEN BEGIN
  37.       Port[$70] := $B;;  Port[$71] := temp AND NOT $80;
  38.     END{IF};
  39.   END {WriteReg};
  40.  
  41. FUNCTION BCD2Bin (BCD:BYTE):BYTE; BEGIN { xlate BCD to binary... }
  42.     BCD2Bin := (BCD AND $0F) + ((BCD SHR 4) * 10);
  43.   END {BCD2Bin};
  44. FUNCTION Bin2BCD (Bin:BYTE):BYTE; BEGIN { xlate binary to BCD... }
  45.     Bin2BCD := (Bin MOD 10) OR BYTE((Bin DIV 10) SHL 4);
  46.   END {Bin2BCD};
  47.  
  48. PROCEDURE GetTime (VAR Hr,Min,Sec:BYTE);
  49.   VAR temp:BYTE; BEGIN
  50.     Sec := ReadReg(0);;  Min := ReadReg(2);
  51.     Hr := ReadReg(4);;  temp := Hr;;  Hr := Hr AND NOT $80;
  52.     IF (ReadReg($B) AND 4) <> 4 THEN BEGIN { xlate BCD to bin... }
  53.       Sec := BCD2Bin(Sec);; Min := BCD2Bin(Min);; Hr := BCD2Bin(Hr);
  54.     END{IF};
  55.     IF (ReadReg($B) AND 2) <> 2 THEN  { RTC in 12-hr mode?... }
  56.       IF (temp AND 128) = 128  { P.M.? }
  57.         THEN BEGIN IF (Hr < 12) THEN INC(Hr,12); END
  58.         ELSE IF Hr = 12 THEN Hr := 0;
  59.   END {GetTime};
  60.  
  61. PROCEDURE SetTime (Hr:To23; Min,Sec:To59);
  62.   VAR temp:BYTE; BEGIN
  63.     temp := BYTE(Hr);
  64.     IF (ReadReg($B) AND 2) <> 2 THEN  { RTC in 12-hr mode?... }
  65.       IF (Hr > 12) THEN DEC(Hr,12) ELSE IF Hr = 0 THEN Hr := 12;
  66.     IF (ReadReg($B) AND 4) <> 4 THEN BEGIN { RTC wants BCD format... }
  67.       Hr := Bin2BCD(Hr);; Min := Bin2BCD(Min);; Sec := Bin2BCD(Sec);
  68.     END{IF};
  69.     IF ((ReadReg($B) AND 2)<>2) AND (temp > 11) THEN Hr := Hr OR $80;
  70.     WriteReg(0,Sec);; WriteReg(2,Min);; WriteReg(4,Hr);
  71.   END {SetTime};
  72.  
  73. PROCEDURE GetDate (VAR Yr,Mth,Day:BYTE); BEGIN
  74.     Day := ReadReg(7);;  Mth := ReadReg(8);;  Yr := ReadReg(9);
  75.     IF (ReadReg($B) AND 4) <> 4 THEN BEGIN { xlate BCD to binay... }
  76.       Day := BCD2Bin(Day);; Mth := BCD2Bin(Mth);; Yr := BCD2Bin(Yr);
  77.     END; {IF}
  78.   END {GetDate};
  79.  
  80. PROCEDURE SetDate (Yr,Mth,Day:BYTE); BEGIN
  81.     IF (ReadReg($B) AND 4) <> 4 THEN BEGIN { RTC wants BCD format... }
  82.       Day := Bin2BCD(Day);; Mth := Bin2BCD(Mth);; Yr := Bin2BCD(Yr);
  83.     END{IF};
  84.     WriteReg(7,Day);;  WriteReg(8,Mth);;  WriteReg(9,Yr);
  85.   END {SetDate};
  86.  
  87. BEGIN {RClock}
  88.   GetTime (Hr,Min,Sec);;  GetDate (Yr,Mth,Day);;  WriteLn;
  89.   Write ('Date is ',Mth,'/',Day,'/',Yr,'. ');
  90.   WriteLn ('Time is ',Hr,':',Min:2,':',Sec:2,'.');
  91.   Write ('(BTW, your RTC is in ');
  92.   IF (ReadReg($B) AND 2) <> 2 THEN Write ('12') ELSE Write ('24');
  93.   Write ('-hour mode using ');
  94.   IF (ReadReg($B) AND 4) <> 4 THEN Write('BCD') ELSE Write('binary');
  95.   WriteLn (' format.)');
  96. END {RClock}.
  97.